Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH6/SRC/BOWDITCH.FRM

Text File | 1996-03-28 | 5KB | 199 lines

VERSION 4.00
Begin VB.Form BowditchForm
   Caption         =   "Bowditch"
   ClientHeight    =   5310
   ClientLeft      =   2085
   ClientTop       =   900
   ClientWidth     =   4830
   Height          =   6000
   Left            =   2025
   LinkTopic       =   "Form1"
   ScaleHeight     =   354
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   322
   Top             =   270
   Width           =   4950
   Begin VB.TextBox PText
      Height          =   285
      Left            =   1320
      TabIndex        =   5
      Text            =   "4"
      Top             =   45
      Width           =   615
   End
   Begin VB.TextBox QText
      Height          =   285
      Left            =   2400
      TabIndex        =   4
      Text            =   "5"
      Top             =   45
      Width           =   615
   End
   Begin VB.TextBox DtText
      Height          =   285
      Left            =   240
      TabIndex        =   3
      Text            =   "0.025"
      Top             =   45
      Width           =   615
   End
   Begin VB.CommandButton CmdGo
      Caption         =   "Go"
      Default         =   -1  'True
      Height          =   375
      Left            =   4200
      TabIndex        =   1
      Top             =   0
      Width           =   615
   End
   Begin VB.PictureBox Canvas
      AutoRedraw      =   -1  'True
      Height          =   4815
      Left            =   0
      ScaleHeight     =   -2.2
      ScaleLeft       =   -1.1
      ScaleMode       =   0  'User
      ScaleTop        =   1.1
      ScaleWidth      =   2.2
      TabIndex        =   0
      Top             =   480
      Width           =   4815
   End
   Begin VB.Label Label1
      Caption         =   "P"
      Height          =   255
      Index           =   3
      Left            =   1200
      TabIndex        =   7
      Top             =   60
      Width           =   255
   End
   Begin VB.Label Label1
      Caption         =   "Q"
      Height          =   255
      Index           =   2
      Left            =   2235
      TabIndex        =   6
      Top             =   60
      Width           =   255
   End
   Begin VB.Label Label1
      Caption         =   "dt"
      Height          =   255
      Index           =   1
      Left            =   0
      TabIndex        =   2
      Top             =   60
      Width           =   255
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
      End
   End
End
Attribute VB_Name = "BowditchForm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

Const PI = 3.14159
Const TWO_PI = 2 * PI

Dim P As Integer
Dim Q As Integer

' ************************************************
' Draw the curve on the indicated picture box.
' ************************************************
Sub DrawCurve(pic As PictureBox, start_t As Single, stop_t As Single, Dt As Single)
Dim t As Single

    pic.Cls
    pic.CurrentX = X(start_t)
    pic.CurrentY = Y(start_t)

    t = start_t + Dt
    Do While t < stop_t
        pic.Line -(X(t), Y(t))
        t = t + Dt
    Loop

    pic.Line -(X(stop_t), Y(stop_t))
End Sub



' ************************************************
' Non-recursively compute the greatest common
' divisor of to integers.
' ************************************************
Private Function GCD(ByVal a As Integer, ByVal b As Integer) As Integer
Dim B_Mod_A As Integer

    B_Mod_A = b Mod a
    Do While B_Mod_A <> 0
        ' Prepare the arguments for the "recursion."
        b = a
        a = B_Mod_A
        B_Mod_A = b Mod a
    Loop

    GCD = a
End Function

' ************************************************
' Calculate the values t must cross to draw a
' Bowditch Curve.
' ************************************************
Sub SetTBounds(tmin As Single, tmax As Single)
    tmin = 0
    tmax = LCM(P, Q) / P / Q * TWO_PI
    If P Mod 2 = 1 And Q Mod 2 = 1 Then
        tmin = -tmax / 4
        tmax = tmax / 4
    End If
End Sub

' ************************************************
' Find the least common multiple of two integers.
' ************************************************
Function LCM(a As Integer, b As Integer) As Integer
    LCM = a * b / GCD(a, b)
End Function

' ************************************************
' The parametric function Y(t).
' ************************************************
Function Y(t As Single) As Single
    Y = Sin(Q * t)
End Function

' ************************************************
' The parametric function X(t).
' ************************************************
Function X(t As Single) As Single
    X = Sin(P * t)
End Function

Private Sub CmdGo_Click()
Dim tmin As Single
Dim tmax As Single
Dim Dt As Single

    P = CInt(PText.Text)
    Q = CInt(QText.Text)

    SetTBounds tmin, tmax

    Dt = CSng(DtText.Text)
    DrawCurve Canvas, tmin, tmax, Dt
End Sub

Private Sub mnuFileExit_Click()
    Unload Me
End Sub